.TITLE	QUEUE
	.IDENT	/10.01/
;
; Copyright (c) 1995 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
; D. N. CUTLER 3-AUG-73
;
; MODIFIED FOR RSX-11M-PLUS V2.1:
;
; 	B. S. MCCARTHY
;
; MODIFIED FOR RSX-11M-PLUS V3.0 BY:
;
;	J. M. LAWLER
;	B. S. MCCARTHY
;	J. W. BERZLE
;
; MODIFIED BY:
;
;	J. W. BERZLE	23-OCT-85	10.00
;
;		JWB167 -- ADD $QRMVA ROUTINE
;
;	D. Carroll	18-Oct-1995	10.01
;		DC404 - Include PSECT statement to allow ICB pool to be
;			fully extended by sysgen
;
;
;
; GENERAL QUEUE MANIPULATION ROUTINES
;
; MACRO LIBRARY CALLS
;

	.MCALL	PKTDF$,PCBDF$,CLKDF$,TCBDF$
	PKTDF$			;DEFINE CLI COMMAND BLOCK OFFSETS
	CLKDF$			;DEFINE CLOCK QUEUE CONTROL BLOCK OFFSETS
	TCBDF$			;DEFINE TASK CONTROL BLOCK OFFSETS
	PCBDF$			;DEFINE PARTITION CONTROL BLOCK OFFSETS

	.IIF	DF,K$$DAS&I$$CBP,	.PSECT	EXEC1				;DC404
										;DC404
;+
; **-$CLINS-CLOCK QUEUE INSERTION
;
; THIS ROUTINE IS CALLED TO MAKE AN ENTRY IN THE CLOCK QUEUE. THE ENTRY
; IS INSERTED SUCH THAT THE CLOCK QUEUE IS ORDERED IN ASCENDING TIME.
; THUS THE FRONT ENTRIES ARE MOST IMMINENT AND THE BACK LEAST.
;
; INPUTS:
;
;	R0=ADDRESS OF THE CLOCK QUEUE ENTRY CORE BLOCK.
;	R1=HIGH ORDER HALF OF DELTA TIME.
;	R2=LOW ORDER HALF OF DELTA TIME.
;	R4=REQUEST TYPE.
;	R5=ADDRESS OF REQUESTING TCB OR REQUEST IDENTIFIER.
;
; OUTPUTS:
;
;	THE CLOCK QUEUE ENTRY IS INSERTED IN THE CLOCK QUEUE ACCORDING
;	TO THE TIME THAT IT WILL COME DUE.
;
; NOTE:
;	ON MULTIPROCESSOR SYSTEMS, A REQUEST WITH TYPE C.SYST!100000
;	WILL BE EXECUTED ON A PRATICULAR UNIBUS RUN, WITH URM
;	SPECIFIED IN C.URM. TYPE C.CYST REQUESTS ON MP SYSTEMS ARE
;	DEFAULTED TO RUN ON ANY UNIBUS RUN, WHICH IN PRACTICE WILL
;	RESULT IN THE REQUEST EXECUTING ON THE CPU WHICH OWNS THE
;	CLOCK. ($CKURM)
;
;	A REQUEST WITH TYPE C.SCHD!100000 OR C.SSHT!100000 INDICATES
;	THAT IT IS A SCHEDULE REQUEST WITH A DEFAULT NAMED DIRECTORY.
;	THIS BIT IS SET IN THE DIRECTIVE CODE (E.G. DRMKT) AND IN
;	TDSCH ON RESCHEDULE REQUESTS.  C.NAM IS SET UP ACCORDINGLY.
;-

	.ENABL	LSB
$CLINS::CLR	(R0)+		;POINT TO TYPE FIELD AND CLEAR LINK
	MOVB	R4,(R0)+	;SET REQUEST TYPE
	INC	R0		;ADVANCE TO TCB ADDRESS
	MOV	R5,(R0)+	;SET TCB OR REQUEST IDENTIFIER
	ADD	$ABTIM,R2	;CALCULATE ABSOLUTE TIME WHEN
	ADC	R1		;REQUEST WILL COME DUE
	MOV	R2,(R0)+	;SET LOW ORDER PART OF TIME
	MOV	R1,(R0)		;SET HIGH ORDER PART OF TIME
	MOV	#$CLKHD,R2	;POINT TO CLOCK QUEUE LIST HEAD
10$:	MOV	R2,R1		;SAVE ADDRESS OF PREVIOUS ENTRY
	MOV	(R1),R2		;GET ADDRESS OF NEXT ENTRY
	BEQ	20$		;IF EQ END OF LIST
	CMP	(R0),C.TIM+2(R2) ;COMPARE HIGH ORDER TIMES
	BHI	10$		;IF HI NOT THIS ENTRY
	BLO	20$		;IF LO ENTRY GOES HERE
	CMP	-2(R0),C.TIM(R2) ;COMPARE LOW ORDER TIMES
	BHIS	10$		;IF HIS NOT THIS ENTRY
20$:	SUB	#8.,R0		;BACK UP TO FRONT OF BLOCK
	MOV	R0,(R1)		;SET NEW NEXT IN PREVIOUS ENTRY
	MOV	R2,(R0)		;SET NEXT IN NEW ENTRY

	.IF DF	N$$DIR

	CMPB	#C.SCHD,R4	;PERIODIC SCHEDULE REQUEST?
	BEQ	25$		;IF EQ, YES
	CMPB	#C.SSHT,R4	;SINGLE SHOT TASK REQUEST
	BNE	27$		;IF NE, NO
25$:	CLRB	C.NAM(R0)	;INDICATE UIC IN CLOCK BLOCK
	TST	R4		;IS THERE A CONTEXT BLOCK INSTEAD OF UIC?
	BPL	27$		;IF PL, NO
	INCB	C.NAM(R0)	;INDICATE CONTEXT BLOCK IN CLOCK BLOCK
27$:				;REFERENCE LABEL

	.ENDC	;DF N$$DIR

	CMPB	#C.SYST,R4	;A SYSTEM ROUTINE REQUEST (DRIVER)?
	BNE	30$		;IF NE NO
	MOV	KINAR5,C.AR5(R0) ;SAVE KERNEL INSTR APR5 MAPPING

	.IF DF	M$$PRO

	TST	R4		;IS THIS A URM SPECIFIC REQUEST ?
	BMI	30$		;IF EQ YES, LEAVE C.URM ALONE
	MOV	#177777,C.URM(R0) ;DEFAULT TO ANY UNIBUS RUN

	.ENDC	; DF M$$PRO

30$:	RETURN			;

;+
; **-$CLRMV-CLOCK QUEUE REMOVAL
; **-$CLRSM-CLOCK QUEUE REMOVAL - SELECTIVE MARK TIME
;
; THIS ROUTINE IS CALLED TO REMOVE ALL ENTRIES FOR A SPECIFIED TCB ADDRESS
; AND REQUEST TYPE FROM THE CLOCK QUEUE, OR SELECTIVELY BY EFN OR AST
; ADDRESS IF ENTRY AT $CLRSM.
;
; INPUTS:
;
;	R1=EFN NUMBER OR 0 (IF ENTRY AT $CLRSM).
;	R2=AST ADDRESS OR 0 (IF ENTRY AT $CLRSM).
;	R4=REQUEST TYPE.
;	R5=ADDRESS OF REQUESTING TCB OR SYSTEM SUBROUTINE.
;
; OUTPUTS:
;
;	ALL OF THE MATCHING ENTRIES FOR THE SPECIFIED TCB ADDRESS ARE
;	REMOVED FROM THE CLOCK QUEUE. IF THE REQUEST TYPE IS NOT 'C.SYST
;	THEN THE CLOCK QUEUE ENTRY CORE BLOCK IS RELEASED.
;-

$CLRMV::CLR	R1		;MATCH ON ANY EVENT FLAG (MKTM ONLY)
	CLR	R2		;MATCH ON ANY AST ADDRESS (MKTM ONLY)
$CLRSM::MOV	#$CLKHD,R0	;POINT TO CLOCK QUEUE LIST HEAD
40$:	MOV	R0,R3		;SAVE ADDRESS OF PREVIOUS ENTRY
	MOV	(R3),R0		;GET ADDRESS OF NEXT ENTRY
	BEQ	30$		;IF EQ END OF LIST
	CMPB	R4,C.RQT(R0)	;REQUEST TYPE MATCH?
	BNE	40$		;IF NE NO
	CMP	R5,C.TCB(R0)	;TCB OR SYSTEM SUBROUTINE ADDRESS MATCH?
	BNE	40$		;IF NE NO
	TST	R4		;MARK TIME ENTRY?
	BNE	60$		;IF NE NO
	TSTB	R1		;EFN SPECIFIED?
	BEQ	50$		;IF EQ NO
	CMPB	R1,C.EFN(R0)	;MATCH ON EFN?
	BEQ	55$		;IF EQ YES, REMOVE ENTRY
	TST	R2		;AST ADDRESS SPECIFIED?
	BEQ	40$		;IGNORE PACKET
50$:	TST	R2		;AST SPECIFIED?
	BEQ	55$		;IF EQ NO
	CMP	R2,C.AST(R0)	;MATCH ON AST?
	BNE	40$		;IF NE NO
55$:	MOV	R2,-(SP)	;SAVE AST ADDRESS
	MOV	R1,-(SP)	;SAVE EVENT FLAG
	MOV	R3,-(SP)	;SAVE ADDRESS OF PREVIOUS ENTRY
	MOV	C.DST(R0),R3	;GET EVENT FLAG MASK ADDRESS
	MOV	T.PCB(R5),R4	;GET TASK PCB

	.IF DF	X$$HDR

	MOV	KISAR6,-(SP)	;SAVE MAPPING FOR POSSIBLE XTRNL HDR
	MOV	P.HDR(R4),-(SP) ;SAVE HEADER ADDRESS
	BNE	57$		;IF EQ HEADER IS RESIDENT IN POOL
	MOV	P.REL(R4),KISAR6 ;MAP TO EXTERNAL HEADER
	MOV	#140000,(SP)	;REPLACE VIRTUAL ADDRESS OF HEADER
57$:	MOV	(SP)+,R4	;GET VIRTUAL ADDRESS OF HEADER

	.IFF	; DF X$$HDR

	MOV	P.HDR(R4),R4	;GET HEADER

	.IFTF	; DF X$$HDR


	.IF DF G$$GEF

	CALL	$DEAGF		;DEACCESS IF GROUP GLOBAL

	.ENDC	; DF G$$GEF


	.IFT	; DF X$$HDR

	MOV	(SP)+,KISAR6	;RESTORE PREVIOUS MAPPING

	.ENDC	; DF X$$HDR

	MOV	(SP)+,R3	;RESTORE ADDRESS OF PREVIOUS ENTRY
	MOV	(SP)+,R1	;RESTORE EVENT FLAG
	MOV	(SP)+,R2	;RESTORE AST ADDRESS
	MOV	(R3),R0		;RESTORE ADDRESS OF CURRENT CLOCK BLK
	CLR	R4		;RESTORE CURRENT REQUEST TYPE
60$:	MOV	(R0),(R3)	;REMOVE ENTRY FROM LIST
	CMPB	#C.SYST,C.RQT(R0) ;SYSTEM SUBROUTINE REQUEST?
	BEQ	40$		;IF EQ YES CONTINUE
	MOV	R2,-(SP)	;SAVE NECESSARY REGISTERS
	MOV	R1,-(SP)	;
	CALL	$DCLKA		;DEALLOCATE CORE (MAY HAVE ACNTING UAB)
	MOV	(SP)+,R1	;RESTORE SAVED REGISTERS
	MOV	(SP)+,R2	;
	BR	$CLRSM		;GO AGAIN
	.DSABL	LSB

;+
; **-$QINSF-QUEUE INSERTION AT END OF LIST (FIFO)
;
; THIS ROUTINE IS CALLED TO MAKE AN ENTRY IN A FIRST IN FIRST OUT
; LIST. THE ENTRY IS LINKED TO THE END OF THE LIST.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TWO WORD LISTHEAD.
;	R1=ADDRESS OF THE ENTRY TO BE INSERTED.
;
; OUTPUTS:
;
;	THE ENTRY IS LINKED TO THE END OF THE QUEUE.
;
;	R0 AND R1 ARE PRESERVED ACROSS CALL.
;-

	.ENABL	LSB
$QINSF::MOV	2(R0),R2	;GET ADDRESS OF LAST ENTRY IN LIST
	BR	20$		;FINISH IN COMMON CODE

;+
; **-$QINSP-QUEUE INSERTION BY PRIORITY
;
; THIS ROUTINE IS CALLED TO INSERT AN ENTRY IN A PRIORITY ORDERED
; LIST. THE LIST IS SEARCHED UNTIL AN ENTRY IS FOUND THAT HAS A
; LOWER PRIORITY OR THE END OF THE LIST IS REACHED. THE NEW
; ENTRY IS THEN LINKED INTO THE LIST AT THE APPROPRIATE POINT.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TWO WORD LISTHEAD.
;	R1=ADDRESS OF THE ENTRY TO BE INSERTED.
;
;
; OUTPUTS:
;
;	THE ENTRY IS LINKED INTO THE LIST BY PRIORITY.
;
;	R0 AND R1 ARE PRESERVED ACROSS CALL.
;-

$QINSP::MOV	R0,R3		;COPY ADDRESS OF LISTHEAD
10$:	MOV	R3,R2		;SAVE ADDRESS OF CURRENT ENTRY
	MOV	(R2),R3		;GET ADDRESS OF NEXT ENTRY
	BEQ	20$		;IF EQ END OF LIST
	CMPB	T.PRI(R1),T.PRI(R3) ;NEW ENTRY LOWER OR SAME PRIORITY?
	BLOS	10$		;IF LOS YES
	MOV	R3,(R1)		;LINK CURRENT TO NEW ENTRY
	BR	30$		;
20$:	MOV	R1,2(R0)	;SET ADDRESS OF NEW LAST
	CLR	(R1)		;CLEAR LINK TO NEXT ENTRY
30$:	MOV	R1,(R2)		;LINK NEW TO PREVIOUS ENTRY
	RETURN			;
	.DSABL	LSB

;+
; **-$QINSB-QUEUE INSERTION AT BEGINNING
;
; THIS ROUTINE IS CALLED TO INSERT A QUEUE ENTRY INTO A QUEUE AT
; THE BEGINNING.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TWO WORD LISTHEAD.
;	R1=ADDRESS OF THE ENTRY TO BE INSERTED.
;
; OUTPUTS:
;
;	THE ENTRY IS LINKED INTO THE QUEUE AT THE FRONT.
;
;	ALL REGISTERS ARE PRESERVED.
;-

$QINSB::MOV	(R0),(R1)	;LINK OLD FIRST TO NEW
	BNE	5$		;IF NE THIS IS NOT NEW LAST
	MOV	R1,2(R0)	;SET NEW LAST POINTER
5$:	MOV	R1,(R0)		;SET NEW FIRST POINTER
	RETURN

;+
; **-$QCNTP-QUEUE CONTROL PACKET TO CLI DISPATCHER
;
; THIS ROUTINE QUEUES SPECIAL PACKETS TO THE CLI DISPATCHER. THESE
; PACKETS CAN BE "BYE" COMMANDS BEING FORCED ON A TERMINAL LINE,
; OR A CONTROL PACKET WITH NO COMMAND TEXT SUCH AS A PROMPT REQUEST.
;
; INPUTS:
;
;	R1=STATUS MASK FOR PACKET, OR ZERO TO GENERATE A BYE COMMAND
;	R2=UCB ADDRESS OF TERMINAL COMMAND IS BEING GENERATED FOR
;
; OUTPUTS:
;
;	C=0 PACKET WAS SUCCESSFULLY QUEUED TO DISPATCHER
;	C=1 PACKET MAY NOT HAVE BEEN SUCCESSFULLY QUEUED
;		Z=0 IF THERE WAS A POOL OR SEC POOL ALLOCATION FAILURE
;		Z=1 IF THE DISPATCHER WAS ALREADY ACTIVE (THIS WILL BE
;			THE NORMAL RETURN SINCE MCR... IS ALWAYS ACTIVE)
;
;-

$QCNTP::MOV	KISAR6,-(SP)	;SAVE OLD MAPPING
	MOV	R1,-(SP)	;SAVE STATUS WORD
	MOV	R2,-(SP)	;SAVE UCB ADDRESS
	MOV	#1,R1		;NEED ONE BLOCK OF SECONDARY POOL
	CALL	$ALSEC		;ALLOCATE IT
	BCS	40$		;IF CS, NO SEC POOL
	MOV	R0,KISAR6	;MAP NEW BLOCK
	MOV	#C.CTCB+140000,R2 ;POINT TO TCB FIELD IN SEC POOL BLOCK
	MOV	$MCRPT,(R2)+	;TCB ADDRESS
	MOV	(SP)+,(R2)+	;UCB ADDRESS
	CLR	(R2)+		;NO TEXT
	MOV	(SP),(R2)+	;INSERT STATUS WORD
	CLR	(R2)+		;INIT STARTING RETURN OFFSET
	MOV	#433,(R2)+	;SET TERMINATOR AND BLOCK COUNT
	TST	(SP)+		;IS THIS A BYE COMMAND
	BNE	20$		;IF NE NO
	MOV	#3,@#C.CCT+140000 ;SET CHARACTER COUNT FOR "BYE"
	BIS	#CC.MCR,@#C.CSTS+140000 ;FORCE BYE COMMAND TO MCR
	MOV	#"BY,(R2)+	;MOVE IN "BYE"
	MOVB	#'E,(R2)+	;
20$:	MOVB	#15,(R2)+	;END WITH A CR
	BR	QUEPKT		;GO TO COMMON CODE
40$:	CMP	(SP)+,(SP)+	;CLEAN STACK
	COM	(SP)+		;SET C, CLEAR Z, AND POP STACK
	RETURN			;

;+
; **-$QCPKT-QUEUE COMMAND LINE PACKET
; **-$QCLNR-QUEUE COMMAND LINE PACKET WITH NO REQUEST OF CLI
;
; THESE ROUTINES QUEUE THE SECONDARY POOL COMMAND PACKET TO THE
; APPROPRIATE CLI, AND OPTIONALLY REQUEST IT TO RUN. THEY COMMAND
; PACKET IN SECONDARY POOL MUST BE COMPLETELY FILLED IN.
;
;
; INPUTS:
;
;	R1=COMMAND PACKET ADDRESS IN SECONDARY POOL (APR BIAS TO MAP IT)
;
; OUTPUTS:
;
;	C=0 IF THE CLI WAS SUCCESSFULLY STARTED AFTER QUEUEING THE COMMAND
;	C=1 IF THE CLI MAY NOT HAVE BEEN SUCCESSFULLY STARTED
;		Z=0 IF A POOL ALLOCATION FAILURE OCCURED
;		Z=1 IF THE CLI WAS ALREADY ACTIVE
;
;	NO STATUS IS RETURNED IF ENTRY WAS AT THE $QCLNR ENTRY POINT
;	SINCE THE QUEUEING OPERATION ITSELF CANNOT FAIL
;
;-

	.ENABL	LSB
$QCLNR::CLR	R2		;FLAG TO INDICATE NO REQUEST
	BR	10$		;
$QCPKT::MOV	SP,R2		;NON ZERO
10$:	MOV	KISAR6,-(SP)	;SAVE CURRENT MAPPING
	MOV	R1,KISAR6	;MAP COMMAND BLOCK
QUEPKT:	MOV	(SP)+,R3	;GET ORIGINAL KISAR6 MAPPING
	MOV	@#C.CTCB+140000,-(SP) ;GET TCB ADDRESS TO REQUEST LATER
	MOV	(SP),-(SP)	;COPY TCB ADDRESS
	TST	R2		;WILL CLI BE REQUESTED
	BNE	15$		;IF NE YES
	CLR	2(SP)		;DO NOT REQUEST CLI
15$:	MOV	@#C.CUCB+140000,R0 ;GET UCB ADDRESS
	CALL	$MPLND		;FOLLOW REDIRECT
	BIT	#DV.TTY,U.CW1(R0) ;IS IT A TERMINAL
	BNE	20$		;IF NE YES
	MOVB	@#C.CBLK+140000,R1 ;GET LENGTH OF BLOCK
	MOV	KISAR6,R0	;ADDRESS OF BLOCK
	MOV	R3,KISAR6	;RESTORE MAPPING
	CMP	(SP)+,(SP)+	;CLEAN STACK
	CALLR	$DESEC		;DEALLOCATE PACKET AND FORGET ABOUT IT
20$:	MOV	KISAR6,R1	;GET ADDRESS OF PACKET
	MOV	R3,KISAR6	;RESTORE MAPPING


	.IF DF	V$$TRM

	MOV	(R0),R2		;GET DCB ADDRESS
	CMP	D.NAM(R2),#"VT	;IS IT A VIRTUAL TERMINAL
	BNE	30$		;IF NE NO
	CMP	$MCRPT,(SP)	;IS COMMAND GOING TO DISPATCHER
	BNE	30$		;IF NE NO
	INCB	U.OCNT(R0)	;INCREMENT USE COUNT OF VIRTUAL TERMINAL
30$:

	.ENDC


	MOV	#$CLICQ,R0	;POINT TO COMMAND QUEUE LISTHEAD
	CALL	$QSPIF		;INSERT IN QUEUE
	MOV	(SP)+,R0	;GET TCB ADDRESS OF CLI


	.IF DF	A$$CLI

	CMP	$MCRPT,R0	;COMMAND GOING TO DISPATCHER
	BEQ	40$		;IF EQ YES, OPTIMIZE BY NOT CHECKING FOR AST
	CALL	$DCAST		;DECLARE COMMAND ARRIVAL AST IF SPECIFIED
	BCS	40$		;IF CS, NO AST DECLARED
	CLR	(SP)		;DO NOT REQUEST CLI SINCE IT GOT AST

	.ENDC	;A$$CLI


40$:	MOV	(SP)+,R0	;GET TCB ADDR OF CLI TO REQUEST
	BEQ	50$		;IF EQ, NO REQUEST
	CALLR	$EXRQN		;REQUEST CLI
50$:	RETURN			;
	.DSABL	LSB

;+
; **-$QMCRL-QUEUE COMMAND LINE TO THE CLI OF A SPECIFIED TERMINAL
; **-$QMCR -QUEUE COMMAND LINE TO MCR REQARDLESS OF TERMINAL'S CLI
; **-$QCLIL-QUEUE COMMAND LINE TO SPECIFIED CLI
;
; THESE ROUTINES QUEUE COMMAND BUFFERS TO A CLI TASK FOR PROCESSING.
; THEY ONLY EXIST TO PROVIDE A COMPATABLE INTERFACE FOR CODE
; THAT HAS NOT BEEN CHANGED TO DEAL WITH THE NEW COMMAND PACKET FORMAT
; AND THE USE OF SECONDARY POOL INSTEAD OF SYSTEM POOL. THEY PRESERVE
; THE OLD INTERFACE BY ACCEPTING A STANDARD 84. BYTE PACKET IN SYSTEM POOL,
; ALLOCATING SECONDARY POOL AND COPYING THE COMMAND
; TEXT INTO IT. THE SYSTEM POOL IS DEALLOCATED, AND THE SECONDARY POOL
; PACKET USED INSTEAD. THIS ADDS CONSIDERABLE OVERHEAD, SO
; THESE ROUTINES SHOULD NOT BE USED BY ANY NEW CODE.
;
; INPUTS:
;
;	R0=CLI TCB ADDRESS ($QCLIL ONLY)
;	R1=ADDRESS OF COMMAND PACKET IN SYSTEM POOL
;
; OUTPUTS:
;
;	C=0 IF CLI WAS SUCCESSFULLY REQUESTED WITH THE COMMAND LINE
;	C=1 IF THE REQUEST MAY NOT HAVE BEEN SUCCESSFUL
;		Z=0 IF A SYSTEM OR SECONDARY POOL ALLOCATION FAILURE OCCURED
;		Z=1 IF THE CLI ALREADY ACTIVE
;
;-

	.ENABL	LSB
$QMCRL::CLR	-(SP)		;GO TO TERMINAL'S CLI
	BR	10$		;
$QMCR::	MOV	#CC.MCR,-(SP)	;FORCE TO MCR
10$:	MOV	$MCRPT,-(SP)	;GIVE COMMAND TO COMMAND DISPATCHER
	BR	20$		;
$QCLIL::CMP	$MCRPT,R0	;IS COMMAND INTENDED FOR MCR
	BEQ	$QMCR		;IF EQ YES
	CLR	-(SP)		;GO TO TERMINAL'S CLI
	MOV	R0,-(SP)	;TCB ADDRESS OF CLI
20$:	MOV	2(R1),-(SP)	;GET UCB ADDR OF SOURCE TERMINAL
	BIT	#1,(SP)		;PROMPT REQUEST??
	BEQ	40$		;IF EQ NO
	MOV	R1,R0		;COPY PACKET ADDRESS
	MOV	#4,R1		;GET LENGTH OF PACKET
30$:	CALL	$DEACB		;DEALLOCATE IT
	MOV	(SP)+,R2	;GET UCB ADDRESS
	BIC	#1,R2		;REMOVE ODD BIT
	CMP	(SP)+,(SP)+	;CLEAN STACK
	MOV	#CC.PRM,R1	;SET PROMPT REQUEST
	JMP	$QCNTP		;CONVERT IT TO PROMPT REQUEST PACKET
40$:	MOV	R1,-(SP)	;SAVE ADDRESS OF PACKET
	MOV	#<M$$CRB-4+C.CTXT+77>/100,R1 ;GET NUMBER OF BLOCKS OF SEC POOL
	CALL	$ALSEC		;ALLOCATE SECONDARY POOL
	BCC	50$		;IF CC, SUCCESS
	MOV	(SP)+,R0	;GET ADDRESS OF SYSTEM POOL PACKET
	MOV	#M$$CRB,R1	;LENGTH OF SYSTEM POOL PACKET
	BR	30$		;ISSUE A PROMPT FOR LACK OF ANYTHING ELSE
50$:	MOV	KISAR6,R3	;SAVE CURRENT MAPPING
	MOV	R0,KISAR6	;MAP SECONDARY POOL BLOCK
	MOV	(SP)+,R0	;GET VALUE OFF STACK TEMPORARILY
	MOV	#C.CUCB+140000,R2 ;POINT TO UCB FIELD IN SECONDARY POOL
	MOV	(SP)+,(R2)+	;INSERT UCB ADDRESS
	MOV	(SP)+,-4(R2)	;INSERT TCB ADDRESS
	CLR	(R2)+		;INIT CHARACTER COUNT
	MOV	(SP)+,(R2)+	;STATUS BITS
	CLR	(R2)+		;INIT STARTING OFFSET OF TEXT
	INC	R2		;SKIP TERMINATOR FIELD
	MOVB	R1,(R2)+	;INSERT NUMBER OF SEC POOL BLOCKS
	MOV	R0,-(SP)	;PUT SYSTEM POOL ADDRESS BACK ON STACK
	CMP	(R0)+,(R0)+	;POINT TO COMMAND TEXT IN POOL
60$:	MOVB	(R0)+,(R2)	;COPY A CHARACTER INTO SEC POOL
	CMPB	#15,(R2)	;IS IT A CARRIAGE RETURN
	BEQ	70$		;IF EQ YES
	CMPB	#33,(R2)	;IS IT AN ESCAPE
	BEQ	70$		;IF EQ YES
	INC	R2		;ADVANCE POINTER
	INC	@#C.CCT+140000	;COUNT THE CHARACTER
	BR	60$		;NEXT CHARACTER
70$:	MOVB	(R2),@#C.CTR+140000 ;SET TERMINATOR
	MOVB	#15,(R2)	;FORCE A CR TO END TEXT
	MOV	(SP)+,R0	;GET ADDRESS OF POOL PACKET
	MOV	#M$$CRB,R1	;LENGTH
	MOV	R3,-(SP)	;SAVE ORIGINAL KISAR6 VALUE
	CALL	$DEACB		;DEALLOCATE IT
	MOV	SP,R2		;INSURE NON-ZERO TO FORCE CLI REQUEST
	JMP	QUEPKT		;GO TO COMMON CODE
	.DSABL	LSB

;+
; **-$SCMDQ-SEARCH COMMAND QUEUE FOR BUFFER FOR SPECIFIED TASK
; **-$SRCCQ-SEARCH QUEUE FOR BUFFER FOR SPECIFIED TASK
; **-$SRUCB-SEARCH QUEUE FOR BUFFER FROM A SPECIFIED TERMINAL
; **-$SRCQ1-SEARCH QUEUE FROM MIDDLE FOR PACKET WITH SPECIFIED TCB ADDR
; **-$SRUC1-SEARCH QUEUE FROM MIDDLE FOR PACKET WITH SPECIFIED UCB ADDR
;
; THESE ROUTINES SEARCH A QUEUE IN SECONDARY POOL FOR SPECIFIC PACKETS.
; THEY ARE MAINLY INTENDED FOR USE ON THE QUEUE CONTAINING COMMAND
; PACKETS, THAT HAVE A TCB ADDRESS AT OFFSET 2, AND A TERMINAL UCB
; ADDRESS AT OFFSET 4. THE LISTHEAD MUST BE IN EXEC SPACE IF THE SEARCH
; STARTS THERE. THE $SRCQ1 AND $SRUC1 ROUTINES START THE SEARCH
; AT ANY PACKET IN THE QUEUE. THIS PACKET DOES NOT HAVE TO BE MAPPED
; WHEN THE ROUTINE IS CALLED. NOTE THAT FOR ANY ROUTINE, THE PACKET
; WILL NOT BE DEQUEUED IF FOUND.
;
; INPUTS:
;	R0=LISTHEAD ADDRESS (FOR $SRCCQ, $SRUCB ONLY)
;	R0=APR VALUE TO MAP PACKET TO START SEARCH AT ($SRCQ1, $SRUC1 ONLY)
;	R5=TCB OR UCB ADDRESS TO LOOK FOR
;
; OUTPUTS:
;
;	C=1 IF THERE IS NO ENTRY IN THE LIST THAT MATCHES
;	C=0 IF THE ENTRY IS FOUND
;		R0=ADDRESS OF BUFFER THAT MATCHES
;
;-

	ASSUME	C.CTCB,2
	ASSUME	C.CUCB,4

	.ENABL	LSB
$SRUCB::MOV	(R0),R0		;POINT TO FIRST ELEMENT IN LIST
$SRUC1::MOV	#4,R1		;GET OFFSET TO UCB ADDRESS IN PACKET
	BR	10$		;GO TO COMMON CODE
$SCMDQ::MOV	#$CLICQ,R0	;POINT TO COMMAND QUEUE LISTHEAD
$SRCCQ::MOV	(R0),R0		;POINT TO FIRST ELEMENT IN LIST
$SRCQ1::MOV	#2,R1		;GET OFFSET TO TCB ADDRESS IN PACKET
10$:	MOV	KISAR6,-(SP)	;SAVE CURRENT MAPPING
	MOV	R0,KISAR6	;MAP FIRST ENTRY
	BEQ	40$		;IF EQ, LIST IS EMPTY
20$:	CMP	R5,140000(R1)	;IS THIS THE ENTRY
	BEQ	50$		;IF EQ YES
	MOV	@#140000,KISAR6	;MAP NEXT BLOCK
	BNE	20$		;IF NE, MORE IN LIST
40$:	SEC			;NOT FOUND
50$:	MOV	KISAR6,R0	;GET ADDRESS OF ENTRY
	MOV	(SP)+,KISAR6	;RESTORE MAPPING
	RETURN
	.DSABL	LSB



;+
; **-$QRMVF-QUEUE REMOVAL FROM FRONT OF LIST
;
; THIS ROUTINE IS CALLED TO REMOVE THE NEXT (FRONT) ENTRY FROM A
; LIST.	THE LIST ORGANIZATION MAY BE EITHER FIFO OR BY PRIORITY.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TWO WORD LISTHEAD.
;
; OUTPUTS:
;
;	C=1 IF THERE ARE NO ENTRIES IN THE LIST.
;	C=0 IF THE NEXT ENTRY IS REMOVED FROM THE LIST.
;		R1=ADDRESS OF THE ENTRY REMOVED.
;
;	R0 IS PRESERVED ACROSS CALL.
;-

	.ENABL	LSB
$QRMVF::MOV	R0,R2		;COPY ADDRESS OF LISTHEAD
	MOV	(R2),R3		;GET ADDRESS OF NEXT ENTRY
	BNE	30$		;IF NE LIST HAS AN ENTRY
10$:	SEC			;NO ENTRIES IN LIST
	RETURN			;

;+
; **-$QRMVA-QUEUE REMOVAL BY BLOCK ADDRESS
;
; THIS ROUTINE IS CALLED TO REMOVE A PARTICULAR BLOCK FROM A LIST.
; LIST ORGANIZATION MAY BE FIFO OR PRIORITY.
;
; INPUTS:
;
;	R0=ADDRESS OF TWO WORD LISTHEAD.
;	R1=ADDRESS OF THE TCB TO SEARCH FOR.
;
; OUTPUTS:
;
;	C=1 IF THERE IS NO ENTRY IN THE LIST THAT MATCHES THE ADDRESS.
;	C=0 IF A MATCHING ENTRY IS REMOVED FROM THE LIST.
;		R1=ADDRESS OF THE ENTRY REMOVED.
;
;	R0 IS PRESERVED ACROSS THE CALL.
;-

$QRMVA::MOV	R0,R3		;COPY ADDRESS OF LISTHEAD
15$:	MOV	R3,R2		;SAVE ADDRESS OF CURRENT ENTRY
	MOV	(R2),R3		;GET ADDRESS OF NEXT ENNTRY
	BEQ	10$		;IF EQ END OF LIST
	CMP	R1,R3		;ADDRESS MATCH ?
	BEQ	30$		;IF EQ YES
	BR	15$		;GO AGAIN

;+
; **-$QRMVT-QUEUE REMOVAL BY TCB ADDRESS
;
; THIS ROUTINE IS CALLED TO REMOVE THE NEXT ENTRY FROM A LIST THAT
; MATCHES A SPECIFIED TCB ADDRESS. THE LIST ORGANIZATION MAY BE
; EITHER FIFO OR BY PRIORITY.
;
; NOTE:  IN ADDITION TO MATCHING R1 WITH THE ELEMENTS ON THE LIST, R1 IS
; ALSO CHECKED AGAINST OFFSET 4 IN EACH ELEMENT ON THE LIST.
;
; FOR EXAMPLE, R1 COULD BE SET TO A TCB AND THE LISTHEAD COULD POINT TO A
; LIST OF I/O PACKETS.  THE PACKET THAT GETS DEQUEUED IS THE ONE WHERE THE
; TCB IN R1 MATCHES THE TCB IN THE I/O PACKET (I.TCB AT OFFSET 4).
;
; THE $DETRG ROUTINE ALSO USES THIS FEATURE WHEN REMOVING ATTACHMENT
; DESCRIPTORS.  SEE $DETRG ROUTINE IN MODULE PLSUB FOR MORE DETAILS.
;
; INPUTS:
;
;	R0=ADDRESS OF THE TWO WORD LISTEAD.
;	R1=ADDRESS OF THE TCB TO SEARCH FOR.
;
; OUTPUTS:
;
;	C=1 IF THERE IS NO ENTRY IN THE LIST THAT MATCHES THE TCB ADDRESS.
;	C=0 IF A MATCHING ENTRY IS REMOVED FROM THE LIST.
;		R1=ADDRESS OF THE ENTRY REMOVED.
;
;	R0 IS PRESERVED ACROSS CALL.
;-


	ASSUME	<A.PCB-A.TCBL>,C.TCB
	ASSUME	<A.TCB-A.PCBL>,C.TCB
	ASSUME  I.TCB,C.TCB

$QRMVT::MOV	R0,R3		;COPY ADDRESS OF LISTHEAD
20$:	MOV	R3,R2		;SAVE ADDRESS OF CURRENT ENTRY
	MOV	(R2),R3		;GET ADDRESS OF NEXT ENTRY
	BEQ	10$		;IF EQ END OF LIST
	CMP	R1,R3		;MATCH ON TCB ADDRESS?
	BEQ	30$		;IF EQ YES
	CMP	R1,C.TCB(R3)	;MATCHING TCB ADDRESS?
	BNE	20$		;IF NE NO
30$:	MOV	(R3),(R2)	;CLOSE UP LIST
	BNE	40$		;IF NE NO NEW LAST
	MOV	R2,2(R0)	;SET ADDRESS OF NEW LAST
40$:	MOV	R3,R1		;SET ADDRESS OF ENTRY REMOVED
	CLC			;SUCCESS
	RETURN			;
	.DSABL	LSB

;+
; **-$QSPIB-QUEUE INSERTION AT BEGINNING IN SECONDARY POOL
;
; THIS ROUTINE IS CALLED TO INSERT AN ENTRY INTO A QUEUE AT THE
; BEGINNING.  THE QUEUE MUST BE IN SECONDARY POOL, WITH A STANDARD 2 WORD
; LISTHEAD IN THE SYSTEM POOL OR SYSCM
;
; INPUTS:
;
;	R0=ADDRESS OF 2 WORD LISTHEAD IN EXEC SPACE
;	R1=ADDRESS OF ENTRY TO BE INSERTED.  ENTRY MUST BE IN SECONDARY POOL
;		THIS VALUE WILL BE LOADED INTO AN APR TO MAP THE ENTRY.
;
;
; OUTPUTS:
;
;	THE ENTRY IS INSERTED IN THE LIST AT THE FRONT
;
;	ALL REGISTERS ARE PRESERVED
;
;-

$QSPIB::


	.IF DF	P$$OOL

	MOV	(R0),-(SP)	;SAVE ADDRESS OF CURRENT FIRST IN LIST
	MOV	KISAR6,-(SP)	;SAVE APR 6 MAPPING
	MOV	R1,KISAR6	;MAP ENTRY TO BE INSERTED
	MOV	2(SP),@#140000	;LINK NEW ENTRY TO PREVIOUS FIRST ENTRY
	MOV	(SP)+,KISAR6	;RESTORE PREVIOUS MAPPING
	TST	(SP)+		;WAS IT NEW LAST IN LIST ?
	BNE	10$		;IF NE, THIS IS NOT NEW LAST
	MOV	R1,2(R0)	;SET NEW LAST POINTER
10$:	MOV	R1,(R0)		;SET NEW FIRST POINTER
	RETURN

;+
; **-$QSPIF-QUEUE INSERTION AT END OF LIST (FIFO)
;
; THIS ROUTINE IS CALLED TO MAKE AN ENTRY IN A FIRST IN FIRST OUT
; LIST.  THE ENTRY IS LINKED TO THE END OF THE LIST.
; THE LIST MUST BE IN SECONDARY POOL, WITH A STANDARD 2 WORD LISTHEAD
; IN THE SYSTEM POOL OR SYSCM.
;
; INPUTS:
;
;	R0=ADDRESS OF 2 WORD LISTHEAD
;	R1=ADDRESS OF ENTRY TO BE INSERTED.  THIS VALUE WILL BE PUT INTO AN
;		APR TO MAP THE ENTRY.
;
; OUTPUTS:
;
;	THE ENTRY IS LINKED TO THE END OF THE QUEUE
;
;	ALL REGISTERS ARE PRESERVED
;
;-

	.IFTF

$QSPIF::

	.IFT

	TST	(R0)		;IS LIST EMPTY
	BEQ	$QSPIB		;IF EQ YES
	MOV	KISAR6,-(SP)	;SAVE MAPPING
	MOV	2(R0),KISAR6	;MAP TO LAST BLOCK IN LIST
	MOV	R1,@#140000	;LINK NEW BLOCK AFTER IT
	MOV	R1,KISAR6	;MAP TO NEW BLOCK
	CLR	@#140000	;CLEAR LINK WORD TO END LIST
	MOV	(SP)+,KISAR6	;RESTORE PREVIOUS MAPPING
	MOV	R1,2(R0)	;UPDATE END OF LIST POINTER
	RETURN

;+
; **-$QSPRF-QUEUE REMOVAL FROM FRONT OF LIST
;
; THIS ROUTINE IS CALLED TO REMOVE THE NEXT (FRONT) ENTRY FROM A
; LIST.  THE LIST MUST BE IN SECONDARY POOL WITH A STANDARD 2 WORD
; LISTHEAD IN SYSTEM POOL OR SYSCM
;
; INPUT:
;
;	R0=ADDRESS OF LISTHEAD IN EXEC SPACE
;
; OUTPUTS:
;
;	C=1 IF THERE ARE NO ENTRIES IN THE LIST
;		R1=0
;	C=0 IF THE NEXT ENTRY IS REMOVED FROM THE LIST.
;		R1=ADDRESS OF ENTRY REMOVED.  THIS ADDRESS SHOULD BE PUT
;			IN AN APR TO MAP THE ENTRY.
;
;  ALL OTHER REGISTERS PRESERVED
;
;-

	.IFTF

$QSPRF::

	.IFT

	SEC			;ASSUME EMPTY LIST
	MOV	(R0),R1		;GET ADDRESS OF FIRST BLOCK IN LIST
	BEQ	20$		;IF EQ, EMPTY LIST
	MOV	KISAR6,-(SP)	;SAVE APR6 MAPPING
	MOV	R1,KISAR6	;MAP TO FIRST BLOCK IN LIST
	MOV	@#140000,R1	;GET POINTER TO NEXT IN LIST
	MOV	(SP),KISAR6	;RESTORE PREVIOUS MAPPING
	MOV	(R0),(SP)	;SAVE ADDRESS OF FIRST IN LIST
	MOV	R1,(R0)		;UNLINK FIRST ELEMENT
	BNE	10$		;IF NE, THERE IS MORE IN LIST
	MOV	R0,2(R0)	;UPDATE END OF LIST POINTER
10$:	MOV	(SP)+,R1	;SET ADDRESS OF FIRST FOR RETURN
	CLC			;AN ELEMENT WAS REMOVED
20$:	RETURN


;+
; **-$QSPIP-QUEUE INSERTION IN SEC. POOL BY PRIORITY
;
; THIS ROUTINE IS CALLED TO INSERT A SECONDARY POOL BLOCK
; INTO A LIST BY ITS PRIORITY FIELD.
;
; INPUTS:
;
;	R0=LISTHEAD ADDRESS IN EXEC SPACE
;	R4=OFFSET INTO BLOCK OF LINKWORD + 140000
;	KISAR6 MAPS THE BLOCK TO BE QUEUED
;
; OUTPUTS:
;
;	NONE.
;
; 	R0-R3 ARE DESTROYED.
;-

$QSPIP::MOV	KISAR6,-(SP)	;SAVE BIAS OF NEW ENTRY
	MOVB	140000+T.PRI,-(SP) ;SAVE PRIORITY OF NEW ENTRY
10$:	MOV	R0,R2		;SAVE ADDRESS OF LAST
	MOV	R1,R3		;SAVE BIAS OF LAST
	MOV	R4,R0		;GET VIRTUAL ADDRESS OF NEXT
	MOV	(R2),R1		;GET BIAS OF NEXT
	BEQ	20$		;IF EQ END OF LIST
	MOV	R1,KISAR6	;MAP TO NEXT BLOCK
	CMPB	140000+T.PRI,(SP) ;BELONG HERE ?
	BHIS	10$		;IF HIS NO
20$:	TST	(SP)+		;DUMP PRIORITY FROM STACK
	MOV	R3,KISAR6	;REMAP TO LAST ENTRY
	MOV	(SP),(R2)	;LINK TO NEW ENTRY
	MOV	(SP)+,KISAR6	;RE-MAP TO NEW ENTRY
	MOV	R1,(R4)		;STUFF LINK POINTER
	RETURN			;


;+
; **-$GTSPK-GET SECONDARY POOL PACKET.
;
; THIS ROUTINE IS CALLED TO DEQUEUE A SPECIFIC PACKET FROM A QUEUE.
;
; INPUTS:
;
;	R0=ADDRESS OF LISTHEAD IN EXEC SPACE.
;	R1=APR VALUE FOR DESIRED PACKET.
;
; OUTPUTS:
;
;	C=1 IF NO PACKET CAN BE DEQUEUED.
;	C=0 IF A PACKET WAS SUCCESSFULLY DEQUEUED.
;		R1=ADDRESS OF THE ENTRY REMOVED.  THIS ADDRESS SHOULD BE
;      	           PUT IN AN APR TO MAP THE ENTRY.
;
;-

$GTSPK::MOV	R0,-(SP)	;SAVE LISTHEAD ADDRESS
	MOV	R2,-(SP)	;SAVE R2
	MOV	KISAR5,-(SP)	;SAVE KERNEL APR 5
	MOV	KISAR6,-(SP)	;SAVE KERNEL APR 6
10$:	SEC			;ASSUME PACKET NOT FOUND
	MOV	(R0),R2		;GET ADDRESS OF NEXT PACKET IN LIST
	BEQ	100$		;IF EQ END OF LIST
	MOV	KISAR5,KISAR6	;SAVE POINTER TO PREVIOUS
	MOV	R2,KISAR5	;MAP THE NEXT PACKET THROUGH APR 5
	CMP	R1,R2		;IS THIS THE DESIRED PACKET?
	BEQ	50$		;IF EQ YES
	MOV	#120000,R0	;POINT TO LINK WORD IN PACKET
	BR	10$		;GET NEXT PACKET
50$:	CMP	R0,6(SP)	;IS THIS THE FIRST IN THE LIST?
	BNE	60$		;IF NE NO
	MOV	(SP)+,KISAR6	;RESTORE APR 6
	CALL	$QSPRF		;DEQUEUE THE PACKET
	BR	110$		;
60$:	MOV	(R0),@#140000	;UNLINK THE PACKET
	BNE	90$		;IF NE NOT LAST IN LIST
	MOV	6(SP),R0	;GET LISTHEAD ADDRESS
	MOV	KISAR6,R2	;COPY LAST IN LIST ADDRESS
	MOV	(SP),KISAR6	;RESTORE PREVIOUS MAPPING
	MOV	R2,2(R0)	;UPDATE LAST IN LIST POINTER
90$:	CLC			;INDICATE SUCCESS
100$:	MOV	(SP)+,KISAR6	;RESTORE APR 6
110$:	MOV	(SP)+,KISAR5	;RESTORE APR 5
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R0	;RESTORE LISTHEAD ADDRESS
	RETURN			;

	.ENDC


	.END